home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / usenet / sources / volume2 / aplictns / hoc.1 < prev    next >
Text File  |  1988-11-10  |  32KB  |  1,511 lines
  1. Path: xanth!nic.MR.NET!tank!mimsy!dftsrv!ukma!mailrus!ulowell!page
  2. From: page@swan.ulowell.edu (Bob Page)
  3. Newsgroups: comp.sources.amiga
  4. Subject: v02i057:  hoc - interactive floating point interpreter
  5. Message-ID: <10117@swan.ulowell.edu>
  6. Date: 10 Nov 88 01:53:42 GMT
  7. Organization: University of Lowell, Computer Science Dept.
  8. Lines: 1500
  9. Approved: page@swan.ulowell.edu
  10.  
  11. Submitted-by: paolucci@snll-arpagw.llnl.gov (Sam Paolucci)
  12. Posting-number: Volume 2, Issue 57
  13. Archive-name: applications/hoc.1
  14.  
  15. Hoc is a programmable interpreter for floating point expressions.  The
  16. code was originally written by none other than Brian Kernighan and Rob
  17. Pike, and documented in their book "The UNIX Programming Environment".
  18. I added other builtin functions that were not in the original version.
  19.  
  20. #    This is a shell archive.
  21. #    Remove everything above and including the cut line.
  22. #    Then run the rest of the file through sh.
  23. #----cut here-----cut here-----cut here-----cut here----#
  24. #!/bin/sh
  25. # shar:    Shell Archiver
  26. #    Run the following text with /bin/sh to create:
  27. #    README
  28. #    code.c
  29. #    hoc.1.cat
  30. #    hoc.1.man
  31. #    hoc.h
  32. #    hoc.ms
  33. #    hoc.y
  34. #    init.c
  35. #    makefile
  36. #    makefile.unix
  37. #    math.c
  38. #    symbol.c
  39. #    test.hoc
  40. # This archive created: Wed Nov  9 20:47:06 1988
  41. cat << \SHAR_EOF > README
  42.                 NOTES
  43.                 -----
  44.  
  45. Hoc is a programmable interpreter for floating point expressions.  The
  46. code was originally written by none other than Brian Kernighan and Rob
  47. Pike, and documented in their book "The UNIX Programming Environment".
  48. I ported the program to the Amiga since I had a need for it.  Along
  49. the way I added other builtin functions that were not in the original
  50. version.  These additions are reflected in the documetation that is
  51. included.  In addition to a manual page, I have also included the
  52. troff documentation for hoc along with its PostScript output. 
  53.  
  54. I was hoping to add the error function as well as the bessel and gamma
  55. functions before letting it out the door, but due to lack of time they
  56. will have to wait for a future update. 
  57.  
  58.                         Enjoy. 
  59.  
  60. Dr. Samuel Paolucci
  61. 1351 Roselli Dr.
  62. Livermore, CA 94550
  63. (415)294-2018
  64.  
  65. ARPA: paolucci@snll-arpagw.llnl.gov
  66. SHAR_EOF
  67. cat << \SHAR_EOF > code.c
  68. #include "hoc.h"
  69. #include "y.tab.h"
  70. #include <stdio.h>
  71.  
  72. #define NSTACK    256
  73.  
  74. static Datum stack[NSTACK];    /* the stack */
  75. static Datum *stackp;        /* next free spot on stack */
  76.  
  77. #define NPROG    2000
  78. Inst    prog[NPROG];        /* the machine */
  79. Inst    *progp;            /* next free spot for code generation */
  80. Inst    *pc;            /* program counter during execution */
  81. Inst    *progbase = prog;    /* start of current subprogram */
  82. int    returning;        /* 1 if return stmt seen */
  83.  
  84. typedef struct Frame {        /* proc/func call stack frame */
  85.     Symbol    *sp;        /* symbol table entry */
  86.     Inst    *retpc;        /* where to resume after return */
  87.     Datum    *argn;        /* n-th argument on stack */
  88.     int    nargs;        /* number of arguments */
  89. } Frame;
  90.  
  91. #define NFRAME    100
  92. Frame    frame[NFRAME];
  93. Frame    *fp;            /* frame pointer */
  94.  
  95. initcode()
  96. {
  97.     progp = progbase;
  98.     stackp = stack;
  99.     fp = frame;
  100.     returning = 0;
  101. }
  102.  
  103. push(d)
  104. Datum d;
  105. {
  106.     if (stackp >= &stack[NSTACK])
  107.         execerror("stack too deep", (char *) 0);
  108.     *stackp++ = d;
  109. }
  110.  
  111. Datum pop()
  112. {
  113.     if (stackp == stack)
  114.         execerror("stack underflow", (char *) 0);
  115.     return *--stackp;
  116. }
  117.  
  118. constpush()
  119. {
  120.     Datum d;
  121.     d.val = ((Symbol *)*pc++)->u.val;
  122.     push(d);
  123. }
  124.  
  125. varpush()
  126. {
  127.     Datum d;
  128.     d.sym = (Symbol *)(*pc++);
  129.     push(d);
  130. }
  131.  
  132. whilecode()
  133. {
  134.     Datum d;
  135.     Inst *savepc = pc;
  136.     
  137.     execute(savepc + 2);            /* condition */
  138.     d = pop();
  139.     while (d.val) {
  140.         execute(*((Inst **)(savepc)));    /* body */
  141.         if (returning)
  142.             break;
  143.         execute(savepc + 2);        /* condition */
  144.         d = pop();
  145.     }
  146.     if (!returning)
  147.         pc = *((Inst **)(savepc + 1));    /* next stmt */
  148. }
  149.  
  150. ifcode()
  151. {
  152.     Datum d;
  153.     Inst *savepc = pc;            /* then part */
  154.     
  155.     execute(savepc + 3);            /* condition */
  156.     d = pop();
  157.     if (d.val)
  158.         execute(*((Inst **)(savepc)));
  159.     else if (*((Inst **)(savepc + 1)))    /* else part? */
  160.         execute(*((Inst **)(savepc + 1)));
  161.     if (!returning)
  162.         pc = *((Inst **)(savepc + 2));    /* next stmt */
  163. }
  164.  
  165. define(sp)    /* put func/proc in symbol table */
  166. Symbol *sp;
  167. {
  168.     sp->u.defn = (Inst)progbase;        /* start of code */
  169.     progbase = progp;            /* next code starts here */
  170. }
  171.  
  172. call()        /* call a function */
  173. {
  174.     Symbol *sp = (Symbol *)pc[0];        /* symbol table entry */
  175.                         /* for function */
  176.     if (fp++ >= &frame[NFRAME - 1])
  177.         execerror(sp->name, "call nested too deeply");
  178.     fp->sp = sp;
  179.     fp->nargs = (int)pc[1];
  180.     fp->retpc = pc + 2;
  181.     fp->argn = stackp - 1;            /* last argument */
  182.     execute(sp->u.defn);
  183.     returning = 0;
  184. }
  185.  
  186. ret()        /* common return from func or proc */
  187. {
  188.     int i;
  189.     for (i = 0; i < fp->nargs; i++)
  190.         pop();                /* pop arguments */
  191.     pc = (Inst *)fp->retpc;
  192.     --fp;
  193.     returning = 1;
  194. }
  195.  
  196. funcret()    /* return from a function */
  197. {
  198.     Datum d;
  199.     if (fp->sp->type == PROCEDURE)
  200.         execerror(fp->sp->name, "(proc) returns value");
  201.     d = pop();            /* preserve function return value */
  202.     ret();
  203.     push(d);
  204. }
  205.  
  206. procret()    /* return from a procedure */
  207. {
  208.     if (fp->sp->type == FUNCTION)
  209.         execerror(fp->sp->name, "(func) returns no value");
  210.     ret();
  211. }
  212.  
  213. double *getarg()    /* return pointer to argument */
  214. {
  215.     int nargs = (int) *pc++;
  216.     if (nargs > fp->nargs)
  217.         execerror(fp->sp->name, "not enough arguments");
  218.     return &fp->argn[nargs - fp->nargs].val;
  219. }
  220.  
  221. arg()        /* push argument onto stack */
  222. {
  223.     Datum d;
  224.     d.val = *getarg();
  225.     push(d);
  226. }
  227.  
  228. argassign()    /* store top of stack in argument */
  229. {
  230.     Datum d;
  231.     d = pop();
  232.     push(d);    /* leave value on stack */
  233.     *getarg() = d.val;
  234. }
  235.  
  236. bltin()
  237. {
  238.     Datum d;
  239.     d = pop();
  240.     d.val = (*(double (*)())*pc++)(d.val);
  241.     push(d);
  242. }
  243.  
  244. eval()        /* evaluate variable on stack */
  245. {
  246.     Datum d;
  247.     d = pop();
  248.     if (d.sym->type != VAR && d.sym->type != UNDEF)
  249.         execerror("attempt to evaluate non-variable", d.sym->name);
  250.     if (d.sym->type == UNDEF)
  251.         execerror("undefined variable", d.sym->name);
  252.     d.val = d.sym->u.val;
  253.     push(d);
  254. }
  255.  
  256. add()
  257. {
  258.     Datum d1, d2;
  259.     d2 = pop();
  260.     d1 = pop();
  261.     d1.val += d2.val;
  262.     push(d1);
  263. }
  264.  
  265. sub()
  266. {
  267.     Datum d1, d2;
  268.     d2 = pop();
  269.     d1 = pop();
  270.     d1.val -= d2.val;
  271.     push(d1);
  272. }
  273.  
  274. mul()
  275. {
  276.     Datum d1, d2;
  277.     d2 = pop();
  278.     d1 = pop();
  279.     d1.val *= d2.val;
  280.     push(d1);
  281. }
  282.  
  283. div()
  284. {
  285.     Datum d1, d2;
  286.     d2 = pop();
  287.     if (d2.val == 0.0)
  288.         execerror("division by zero", (char *) 0);
  289.     d1 = pop();
  290.     d1.val /= d2.val;
  291.     push(d1);
  292. }
  293.  
  294. negate()
  295. {
  296.     Datum d;
  297.     d = pop();
  298.     d.val = -d.val;
  299.     push(d);
  300. }
  301.  
  302. gt()
  303. {
  304.     Datum d1, d2;
  305.     d2 = pop();
  306.     d1 = pop();
  307.     d1.val = (double)(d1.val > d2.val);
  308.     push(d1);
  309. }
  310.  
  311. lt()
  312. {
  313.     Datum d1, d2;
  314.     d2 = pop();
  315.     d1 = pop();
  316.     d1.val = (double)(d1.val < d2.val);
  317.     push(d1);
  318. }
  319.  
  320. ge()
  321. {
  322.     Datum d1, d2;
  323.     d2 = pop();
  324.     d1 = pop();
  325.     d1.val = (double)(d1.val >= d2.val);
  326.     push(d1);
  327. }
  328.  
  329. le()
  330. {
  331.     Datum d1, d2;
  332.     d2 = pop();
  333.     d1 = pop();
  334.     d1.val = (double)(d1.val <= d2.val);
  335.     push(d1);
  336. }
  337.  
  338. eq()
  339. {
  340.     Datum d1, d2;
  341.     d2 = pop();
  342.     d1 = pop();
  343.     d1.val = (double)(d1.val == d2.val);
  344.     push(d1);
  345. }
  346.  
  347. ne()
  348. {
  349.     Datum d1, d2;
  350.     d2 = pop();
  351.     d1 = pop();
  352.     d1.val = (double)(d1.val != d2.val);
  353.     push(d1);
  354. }
  355.  
  356. and()
  357. {
  358.     Datum d1, d2;
  359.     d2 = pop();
  360.     d1 = pop();
  361.     d1.val = (double)(d1.val != 0.0 && d2.val != 0.0);
  362.     push(d1);
  363. }
  364.  
  365. or()
  366. {
  367.     Datum d1, d2;
  368.     d2 = pop();
  369.     d1 = pop();
  370.     d1.val = (double)(d1.val != 0.0 || d2.val != 0.0);
  371.     push(d1);
  372. }
  373.  
  374. not()
  375. {
  376.     Datum d;
  377.     d = pop();
  378.     d.val = (double)(d.val == 0.0);
  379.     push(d);
  380. }
  381.  
  382. power()
  383. {
  384.     Datum d1, d2;
  385.     extern double Pow();
  386.     d2 = pop();
  387.     d1 = pop();
  388.     d1.val = Pow(d1.val, d2.val);
  389.     push(d1);
  390. }
  391.  
  392. assign()
  393. {
  394.     Datum d1, d2;
  395.     d1 = pop();
  396.     d2 = pop();
  397.     if (d1.sym->type != VAR && d1.sym->type != UNDEF)
  398.         execerror("assignment to non-variable", d1.sym->name);
  399.     d1.sym->u.val = d2.val;
  400.     d1.sym->type = VAR;
  401.     push(d2);
  402. }
  403.  
  404. print()        /* pop top value from stack, print it */
  405. {
  406.     Datum d;
  407.     d = pop();
  408.     printf("\t%.8g\n", d.val);
  409. }
  410.  
  411. prexpr()    /* print numeric value */
  412. {
  413.     Datum d;
  414.     d = pop();
  415.     printf("%.8g ", d.val);
  416. }
  417.  
  418. prstr()        /* print string value */
  419. {
  420.     printf("%s", (char *) *pc++);
  421. }
  422.  
  423. varread()    /* read into variable */
  424. {
  425.     Datum d;
  426.     extern FILE *fin;
  427.     Symbol *var = (Symbol *) *pc++;
  428. Again:
  429.     switch (fscanf(fin, "%lf", &var->u.val)) {
  430.     case EOF:
  431.         if (moreinput())
  432.             goto Again;
  433.         d.val = var->u.val = 0.0;
  434.         break;
  435.     case 0:
  436.         execerror("non-number read into", var->name);
  437.         break;
  438.     default:
  439.         d.val = 1.0;
  440.         break;
  441.     }
  442.     var->type = VAR;
  443.     push(d);
  444. }
  445.  
  446. Inst *code(f)    /* install one instruction or operand */
  447. Inst f;
  448. {
  449.     Inst *oprogp = progp;
  450.     if (progp >= &prog[NPROG])
  451.         execerror("program too big", (char *) 0);
  452.     *progp++ = f;
  453.     return oprogp;
  454. }
  455.  
  456. execute(p)
  457. Inst *p;
  458. {
  459.     for (pc = p; *pc != STOP && !returning; )
  460.         (*(*pc++))();
  461. }
  462.  
  463.  
  464.     
  465. SHAR_EOF
  466. cat << \SHAR_EOF > hoc.1.cat
  467.  
  468.  
  469.  
  470.                                                            HOC(1)
  471.  
  472.  
  473.  
  474. NAME
  475.      hoc - interactive floating point language
  476.  
  477. SYNOPSIS
  478.      hoc [ file ... ]
  479.  
  480. DESCRIPTION
  481.      _H_o_c interprets a simple language for floating point arith-
  482.      metic, at about the level of BASIC, with C-like syntax and
  483.      functions and procedures with arguments and recursion.
  484.  
  485.      The named _f_i_l_es are read and interpreted in order.  If no
  486.      _f_i_l_e is given or if _f_i_l_e is `-' _h_o_c interprets the standard
  487.      input.
  488.  
  489.      _H_o_c input consists of _e_x_p_r_e_s_s_i_o_n_s and _s_t_a_t_e_m_e_n_t_s.  Expres-
  490.      sions are evaluated and their results printed.  Statements,
  491.      typically assignments and function or procedure definitions,
  492.      produce no output unless they explicitly call _p_r_i_n_t.
  493.  
  494. SEE ALSO
  495.      _H_o_c - _A_n _I_n_t_e_r_a_c_t_i_v_e _L_a_n_g_u_a_g_e _f_o_r _F_l_o_a_t_i_n_g _P_o_i_n_t _A_r_i_t_h_m_e_t_i_c
  496.      by Brian Kernighan and Rob Pike.
  497.      _b_a_s(1), _b_c(1) and _d_c(1).
  498.  
  499. BUGS
  500.      Error recovery is imperfect within function and procedure
  501.      definitions.
  502.      The treatment of newlines is not exactly user-friendly.
  503.  
  504.  
  505.  
  506.  
  507.  
  508.  
  509.  
  510.  
  511.  
  512.  
  513.  
  514.  
  515.  
  516.  
  517.  
  518.  
  519.  
  520.  
  521.  
  522.  
  523.  
  524.  
  525.  
  526.  
  527.  
  528.  
  529.                                                                 1
  530.  
  531.  
  532.  
  533. SHAR_EOF
  534. cat << \SHAR_EOF > hoc.1.man
  535. .TH HOC 1
  536. .SH NAME
  537. hoc \- interactive floating point language
  538. .SH SYNOPSIS
  539. .B hoc
  540. [ file ... ]
  541. .SH DESCRIPTION
  542. .I Hoc
  543. interprets a simple language for floating point arithmetic,
  544. at about the level of BASIC, with C-like syntax and
  545. functions and procedures with arguments and recursion.
  546. .PP
  547. The named
  548. .IR file s
  549. are read and interpreted in order.
  550. If no
  551. .I file
  552. is given or if
  553. .I file
  554. is `\-'
  555. .I hoc
  556. interprets the standard input.
  557. .PP
  558. .I Hoc
  559. input consists of
  560. .I expressions
  561. and
  562. .IR statements .
  563. Expressions are evaluated and their results printed.
  564. Statements, typically assignments and function or procedure
  565. definitions, produce no output unless they explicitly call
  566. .IR print .
  567. .SH "SEE ALSO"
  568. .I
  569. Hoc \- An Interactive Language for Floating Point Arithmetic
  570. by Brian Kernighan and Rob Pike.
  571. .br
  572. .IR bas (1),
  573. .IR bc (1)
  574. and
  575. .IR dc (1).
  576. .SH BUGS
  577. Error recovery is imperfect within function and procedure definitions.
  578. .br
  579. The treatment of newlines is not exactly user-friendly.
  580. SHAR_EOF
  581. cat << \SHAR_EOF > hoc.h
  582. typedef struct Symbol {    /* symbol table entry */
  583.     char    *name;
  584.     short    type;
  585.     union {
  586.         double    val;        /* VAR            */
  587.         double    (*ptr)();    /* BLTIN        */
  588.         int    (*defn)();    /* FUNCTION, PROCEDURE    */
  589.         char    *str;        /* STRING        */
  590.     } u;
  591.     struct Symbol    *next;        /* to link to another */
  592. } Symbol;
  593. Symbol    *install(), *lookup();
  594.  
  595. typedef union Datum {    /* interpreter stack type */
  596.     double    val;
  597.     Symbol    *sym;
  598. } Datum;
  599. extern    Datum pop();
  600. extern    eval(), add(), sub(), mul(), div(), negate(), power();
  601.  
  602. typedef int (*Inst)();
  603. #define STOP    (Inst) 0
  604.  
  605. extern Inst *progp, *progbase, prog[], *code();
  606. extern assign(), bltin(), varpush(); constpush(), print(), varread();
  607. extern prexpr(), prstr();
  608. extern gt(), lt(), eq(), ge(), le(), ne(), and(), or(), not();
  609. extern ifcode(), whilecode(), call(), arg(), argassign();
  610. extern funcret(), procret();
  611. SHAR_EOF
  612. cat << \SHAR_EOF > hoc.ms
  613. .TL
  614. Hoc - An Interactive Language For Floating Point Arithmetic
  615. .AU
  616. Brian Kernighan
  617. Rob Pike
  618. .AB
  619. .I Hoc
  620. is a simple programmable interpreter
  621. for floating point expressions.
  622. It has C-style control flow,
  623. function definition and the usual
  624. numerical built-in functions
  625. such as cosine and logarithm.
  626. .AE
  627. .NH
  628. Expressions
  629. .PP
  630. .I Hoc
  631. is an expression language,
  632. much like C:
  633. although there are several control-flow statements,
  634. most statements such as assignments
  635. are expressions whose value is disregarded.
  636. For example, the assignment operator
  637. = assigns the value of its right operand
  638. to its left operand, and yields the value,
  639. so multiple assignments work.
  640. The expression grammar is:
  641. .DS
  642. .I
  643. expr:        number
  644.     |    variable
  645.     |    ( expr )
  646.     |    expr binop expr
  647.     |    unop expr
  648.     |    function ( arguments )
  649. .R
  650. .DE
  651. Numbers are floating point.
  652. The input format is that recognized by
  653. .I scanf
  654. (3): digits, decimal point, digits,
  655. .I e
  656. or
  657. .I E,
  658. signed exponent.  At least one digit or a decimal point must be present;
  659. the other components are optional.
  660. .PP
  661. Variable names are formed from a letter followed
  662. by a string of letters and numbers.
  663. .I binop
  664. refers to binary operators such as addition or logical comparison;
  665. .I unop
  666. refers to the two negation operators, `!' (logical negation, `not')
  667. and `\-' (arithmetic negation, sign change).
  668. Table 1 lists the operators.
  669. .TS
  670. center, box;
  671. c s
  672. lfCW l.
  673. \fBTable 1:\fP  Operators, in decreasing order of precedence
  674. .sp .5
  675. ^    exponentiation (\s-1FORTRAN\s0 **), right associative
  676. ! \-    (unary) logical and arithmetic negation
  677. * /    multiplication, division
  678. + \-    addition, subtraction
  679. > >=    relational operators: greater, greater or equal,
  680. < <=      less, less or equal,
  681. \&== !=      equal, not equal (all same precedence)
  682. &&    logical AND (both operands always evaluated)
  683. | |    logical OR (both operands always evaluated)
  684. \&=    assignment, right associative
  685. .TE
  686. .PP
  687. Functions, as described later, may be defined by the user.
  688. Function arguments are expressions separated by commas.
  689. There are also a number of built-in functions,
  690. all of which take a single argument, described in Table 2.
  691. .EQ
  692. delim @@
  693. .EN
  694. .TS
  695. center, box;
  696. c s
  697. lfCW l.
  698. \fBTable 2:\fP  Built-in Functions
  699. .sp .5
  700. abs(x)    @|x|@, absolute value of @x@
  701. acos(x)    arc cosine of @x@
  702. asin(x)    arc sine of @x@
  703. atan(x)    arc tangent of @x@
  704. ceil(x)    smallest integer not less than @x@
  705. cos(x)    @cos(x)@, cosine of @x@
  706. cosh(x)    hyperbolic cosine of @x@
  707. exp(x)    @e sup x@, exponential of @x@
  708. floor(x)    largest integer not greater than @x@
  709. int(x)    integer part of @x@, truncated towards zero
  710. log(x)    @log(x)@, logarithm base @e@ of @x@
  711. log10(x)    @log sub 10 (x)@, logarithm base 10 of @x@
  712. ran(x)    random number between 0.0 and 1.0
  713. sin(x)    @sin(x)@, sine of @x@
  714. sinh(x)    hyperbolic sine of @x@
  715. sqrt(x)    @sqrt x@ , @x sup 1/2@
  716. tan(x)    tangent of @x@
  717. tanh(x)    hyperbolic tangent of @x@
  718. .TE
  719. .PP
  720. Logical expressions have value 1.0 (true) and 0.0 (false).
  721. As in C, any non-zero value is taken to be true.
  722. As is always the case with floating point numbers,
  723. equality comparisons are inherently suspect.
  724. .PP
  725. .I Hoc
  726. also has a few built-in constants, shown in Table 3.
  727. .TS
  728. center, box;
  729. c s s
  730. lfCW n l.
  731. \fBTable 3:\fP  Built-in Constants
  732. .sp .5
  733. DEG    57.29577951308232087680        @ 180/ pi @, degrees per radian
  734. E    2.71828182845904523536        @ e @, base of natural logarithms
  735. GAMMA    0.57721566490153286060        @ gamma @, Euler-Mascheroni constant
  736. PHI    1.61803398874989484820        @ ( sqrt 5 +1)/2 @, the golden ratio
  737. PI    3.14159265358979323846        @ pi @, circular transcendental number
  738. .TE
  739. .NH
  740. Statements and Control Flow
  741. .PP
  742. .I Hoc
  743. statements have the following grammar:
  744. .DS
  745. .I
  746. stmt:        expr
  747.     |    variable = expr
  748.     |    procedure ( arglist )
  749.     |    while ( expr ) stmt
  750.     |    if ( expr ) stmt
  751.     |    if ( expr ) stmt else stmt
  752.     |    { stmtlist }
  753.     |    print expr-list
  754.     |    return optional-expr
  755.  
  756. stmtlist:    (nothing)
  757.     |    stmtlist stmt
  758. .R
  759. .DE
  760. An assignment is parsed by default as a statement rather than
  761. an expression, so assignements typed interactively do not print
  762. their value.
  763. .PP
  764. Note that semicolons are not special to
  765. .I hoc:
  766. statements are terminated by newlines.  This causes some
  767. peculiar behavior.  The following are legal
  768. .I if
  769. statements:
  770. .DS
  771. if (x < 0) print(y) else print(z)
  772.  
  773. if (x < 0) {
  774.     print(y)
  775. } else {
  776.     print(z)
  777. }
  778. .DE
  779. In the second example, the braces are mandatory:
  780. the newline after the
  781. .I if
  782. would terminate the statement and produce a syntax error
  783. were the brace omitted.
  784. .PP
  785. The syntax and semantics of
  786. .I hoc
  787. control flow facilities are basically the same as in C.  The
  788. .I while
  789. and
  790. .I if
  791. statements are just as in C, except there are no
  792. .I break
  793. or
  794. .I continue
  795. statements.
  796. .NH
  797. Input and Output: \fIread \fBand \fIprint
  798. .PP
  799. The input function
  800. .I read,
  801. like the other built-ins, takes a single argument.
  802. Unlike the built-ins, though, the argument is not an expression:
  803. it is the name of a variable.  The next number (as defined above)
  804. is read from the standard input and assigned to the named variable.
  805. The return value of
  806. .I read
  807. is 1 (true) if a value was read, and 0 (false) if
  808. .I read
  809. encountered end of file or an error.
  810. .PP
  811. Output is generated with the
  812. .I print
  813. statement.  The arguments to
  814. .I print
  815. are a comma-separated list of expressions and strings in double quotes,
  816. as in C.  Newlines must be supplied; they are never provided automatically by
  817. .I print.
  818. .PP
  819. Note that
  820. .I read
  821. is a special built-in function, and therefore takes a single
  822. parenthesized argument, while
  823. .I print
  824. is a statement that takes a comma-separated, unparenthesized list:
  825. .DS
  826. while (read(x)) {
  827.     print "value is ", x, " \en"
  828. }
  829. .DE
  830. .NH
  831. Functions and Procedures
  832. .PP
  833. Functions and procedures are distinct in
  834. .I hoc,
  835. although they are defined by the same mechanism.  This distinction
  836. is simply for run-time error checking: it is an error for a
  837. procedure to return a value, and for a function
  838. .I not
  839. to return one.
  840. .PP
  841. The definition syntax is:
  842. .DS
  843. .I
  844. function:    func name() stmt
  845.  
  846. procedure:    proc name() stmt
  847. .R
  848. .DE
  849. .I name
  850. may be the name of any variable \(em built-in functions are excluded.
  851. The definition, up to the opening brace or statement, must be on one line, as with the
  852. .I if
  853. statement above.
  854. .PP
  855. Unlike C, the body of a function or procedure may be any statement,
  856. not necessarily a compound (brace-enclosed) statement.  Since semicolons
  857. have no meaning in
  858. .I hoc,
  859. a null procedure body is formed by an empty pair of braces.
  860. .PP
  861. Functions and procedures may take arguments, separated by commas,
  862. when invoked.  Arguments are referred to as in the shell:
  863. .I $3
  864. refers to the third (1-indexed) argument.  They are passed by value
  865. and within functions are semantically equivalent to variables.
  866. It is an error to refer to an argument numbered greater than the
  867. number of arguments passed to the routine.  The error checking
  868. is done dynamically, however, so a routine may have variable
  869. number of arguments if initial arguments affect the number of
  870. arguments to be referenced (as in C's
  871. .I printf
  872. ).
  873. .PP
  874. Functions and procedures may recurse, but the stack has limited depth
  875. (about a hundred calls).  The following shows a
  876. .I hoc
  877. definition of Ackermann's function:
  878. .DS
  879.     $ hoc
  880.     func ack() {
  881.         if ($1 == 0) return $2+1
  882.         if ($2 == 0) return ack($1-1, 1)
  883.         return ack($1-1, ack($1, $2-1))
  884.     }
  885.     ack(3, 2)
  886.         29
  887.     ack(3, 3)
  888.         61
  889.     ack(3, 4)
  890.     hoc: stack too deep near line 8
  891.     . . .
  892. .DE
  893. .NH
  894. Examples
  895. .PP
  896. Stirling's formula
  897. .EQ
  898. n!~\~ ~ sqrt {2 n pi} ( n / e ) sup n ( 1 + 1 over { 12 n } )
  899. .EN
  900. .DS
  901.     $ hoc
  902.     func stirl() {
  903.         return sqrt(2*$1*PI) * ($1/E)^$1*(1 + 1/(12*$1))
  904.     }
  905.     stirl(10)
  906.         3628684.7
  907.     stirl(20)
  908.         2.4328818e+18
  909. .DE
  910. .PP
  911. Factorial function,
  912. .I n!
  913. :
  914. .DS
  915.     func fac() if ($1 <= 0) return 1 else return $1 * fac($1-1)
  916. .DE
  917. .PP
  918. Ratio of factorial to Stirling approximation:
  919. .DS
  920.     i = 9
  921.     while ((i = i+1) <= 20) {
  922.         print i, "  ", fac(i)/stirl(i), " \en"
  923.     }
  924.     10   1.0000318
  925.     11   1.0000265
  926.     12   1.0000224
  927.     13   1.0000192
  928.     14   1.0000166
  929.     15   1.0000146
  930.     16   1.0000128
  931.     17   1.0000114
  932.     18   1.0000102
  933.     19   1.0000092
  934.     20   1.0000083
  935. .DE
  936. SHAR_EOF
  937. cat << \SHAR_EOF > hoc.y
  938. %{
  939. #include "hoc.h"
  940. #define code2(c1,c2)    code(c1); code(c2)
  941. #define code3(c1,c2,c3)    code(c1); code(c2); code(c3)
  942. %}
  943. %union {
  944.     Symbol    *sym;    /* symbol table pointer */
  945.     Inst    *inst;    /* machine instruction  */
  946.     int    narg;    /* number of arguments  */
  947. }
  948. %token    <sym>    NUMBER STRING PRINT VAR BLTIN UNDEF WHILE IF ELSE
  949. %token    <sym>    FUNCTION PROCEDURE RETURN FUNC PROC READ
  950. %token    <narg>    ARG
  951. %type    <inst>    expr stmt asgn prlist stmtlist
  952. %type    <inst>    cond while if begin end
  953. %type    <sym>    procname
  954. %type    <narg>    arglist
  955. %right    '='
  956. %left    OR
  957. %left    AND
  958. %left    GT GE LT LE EQ NE
  959. %left    '+' '-'
  960. %left    '*' '/'
  961. %left    UNARYMINUS NOT
  962. %right    '^'
  963. %%
  964. list:      /* nothing */
  965.     | list '\n'
  966.     | list defn '\n'
  967.     | list asgn '\n'  { code2(pop, STOP); return 1; }
  968.     | list stmt '\n'  { code(STOP); return 1; }
  969.     | list expr '\n'  { code2(print, STOP); return 1; }
  970.     | list error '\n' { yyerrok; }
  971.     ;
  972. asgn:      VAR '=' expr { code3(varpush, (Inst)$1, assign); $$ = $3; }
  973.     | ARG '=' expr 
  974.         { defnonly("$"); code2(argassign, (Inst)$1); $$ = $3; }
  975.     ;
  976. stmt:      expr  { code(pop); }
  977.     | RETURN { defnonly("return"); code(procret); }
  978.     | RETURN expr 
  979.         { defnonly("return"); $$ = $2; code(funcret); }
  980.     | PROCEDURE begin '(' arglist ')' 
  981.         { $$ = $2; code3(call, (Inst)$1, (Inst)$4); }
  982.     | PRINT prlist  { $$ = $2; }
  983.     | while cond stmt end {
  984.         ($1)[1] = (Inst)$3;        /* body of loop        */
  985.         ($1)[2] = (Inst)$4; }        /* end, if cond fails    */
  986.     | if cond stmt end {            /* else-less if        */
  987.         ($1)[1] = (Inst)$3;        /* thenpart        */
  988.         ($1)[3] = (Inst)$4; }        /* end, if cond fails    */
  989.     | if cond stmt end ELSE stmt end {    /* if with else        */
  990.         ($1)[1] = (Inst)$3;        /* thenpart        */
  991.         ($1)[2] = (Inst)$6;        /* elsepart        */
  992.         ($1)[3]    = (Inst)$7; }        /* end, if cond fails    */
  993.     | '{' stmtlist '}'    { $$ = $2; }
  994.     ;
  995. cond:      '(' expr ')'    { code(STOP); $$ = $2; }
  996.     ;
  997. while:      WHILE    { $$ = code3(whilecode, STOP, STOP); }
  998.     ;
  999. if:      IF    { $$ = code(ifcode); code3(STOP, STOP, STOP); }
  1000.     ;
  1001. begin:      /* nothing */        { $$ = progp; }
  1002.     ;
  1003. end:      /* nothing */        { code(STOP); $$ = progp; }
  1004.     ;
  1005. stmtlist: /* nothing */        { $$ = progp; }
  1006.     | stmtlist '\n'
  1007.     | stmtlist stmt
  1008.     ;
  1009. expr:      NUMBER { $$ = code2(constpush, (Inst)$1); }
  1010.     | VAR     { $$ = code3(varpush, (Inst)$1, eval); }
  1011.     | ARG     { defnonly("$"); $$ = code2(arg, (Inst)$1); }
  1012.     | asgn
  1013.     | FUNCTION begin '(' arglist ')'
  1014.         { $$ = $2; code3(call, (Inst)$1, (Inst)$4); }
  1015.     | READ '(' VAR ')' { $$ = code2(varread, (Inst)$3); }
  1016.     | BLTIN '(' expr ')' { $$ = $3; code2(bltin, (Inst)$1->u.ptr); }
  1017.     | '(' expr ')'    { $$ = $2; }
  1018.     | expr '+' expr    { code(add); }
  1019.     | expr '-' expr    { code(sub); }
  1020.     | expr '*' expr    { code(mul); }
  1021.     | expr '/' expr    { code(div); }
  1022.     | expr '^' expr    { code(power); }
  1023.     | '-' expr   %prec UNARYMINUS    { $$ = $2; code(negate); }
  1024.     | expr GT expr    { code(gt); }
  1025.     | expr GE expr    { code(ge); }
  1026.     | expr LT expr    { code(lt); }
  1027.     | expr LE expr    { code(le); }
  1028.     | expr EQ expr    { code(eq); }
  1029.     | expr NE expr    { code(ne); }
  1030.     | expr AND expr    { code(and); }
  1031.     | expr OR expr    { code(or); }
  1032.     | NOT expr    { $$ = $2; code(not); }
  1033.     ;
  1034. prlist:      expr            { code(prexpr); }
  1035.     | STRING        { $$ = code2(prstr, (Inst)$1); }
  1036.     | prlist ',' expr    { code(prexpr); }
  1037.     | prlist ',' STRING    { code2(prstr, (Inst)$3); }
  1038.     ;
  1039. defn:      FUNC procname    { $2->type = FUNCTION; indef = 1; }
  1040.         '(' ')' stmt { code(procret); define($2); indef = 0; }
  1041.     | PROC procname    { $2->type = PROCEDURE; indef = 1; }
  1042.         '(' ')' stmt { code(procret); define($2); indef = 0; }
  1043.     ;
  1044. procname: VAR
  1045.     | FUNCTION
  1046.     | PROCEDURE
  1047.     ;
  1048. arglist:  /* nothing */        { $$ = 0; }
  1049.     | expr            { $$ = 1; }
  1050.     | arglist ',' expr    { $$ = $1 + 1; }
  1051.     ;
  1052. %%
  1053.       /* end of grammar */
  1054. #include <stdio.h>
  1055. #include <ctype.h>
  1056. char    *progname;
  1057. int    lineno = 1;
  1058. #include <signal.h>
  1059. #include <setjmp.h>
  1060. jmp_buf    begin;
  1061. int    indef;
  1062. char    *infile;    /* input file name    */
  1063. FILE    *fin;        /* input file pointer    */
  1064. char    **gargv;    /* global argument list    */
  1065. int    gargc;
  1066.  
  1067. int    c;        /* global for use by warning() */
  1068. yylex()            /* hoc */
  1069. {
  1070.     while ((c = getc(fin)) == ' ' || c == '\t')
  1071.         ;
  1072.     if (c == EOF)
  1073.         return 0;
  1074.     if (c == '.' || isdigit(c)) {    /* number */
  1075.         double d;
  1076.         ungetc(c, fin);
  1077.         fscanf(fin, "%lf", &d);
  1078.         yylval.sym = install("", NUMBER, d);
  1079.         return NUMBER;
  1080.     }
  1081.     if (isalpha(c)) {
  1082.         Symbol *s;
  1083.         char sbuf[100], *p = sbuf;
  1084.         do {
  1085.             if (p >= sbuf + sizeof(sbuf) - 1) {
  1086.                 *p = '\0';
  1087.                 execerror("name too long", sbuf);
  1088.             }
  1089.             *p++ = c;
  1090.         } while ((c = getc(fin)) != EOF && isalnum(c));
  1091.         ungetc(c, fin);
  1092.         *p = '\0';
  1093.         if ((s = lookup(sbuf)) == 0)
  1094.             s = install(sbuf, UNDEF, 0.0);
  1095.         yylval.sym = s;
  1096.         return s->type == UNDEF ? VAR : s->type;
  1097.     }
  1098.     if (c == '$') {    /* argument? */
  1099.         int n = 0;
  1100.         while (isdigit(c = getc(fin)))
  1101.             n = 10 * n + c - '0';
  1102.         ungetc(c, fin);
  1103.         if (n == 0)
  1104.             execerror("strange $...", (char *)0);
  1105.         yylval.narg = n;
  1106.         return ARG;
  1107.     }
  1108.     if (c == '"') {    /* quoted string */
  1109.         char sbuf[100], *p, *emalloc();
  1110.         for (p = sbuf; (c = getc(fin)) != '"'; p++) {
  1111.             if (c == '\n' || c == EOF)
  1112.                 execerror("missing quote", "");
  1113.             if (p >= sbuf + sizeof(sbuf) - 1) {
  1114.                 *p = '\0';
  1115.                 execerror("string too long", sbuf);
  1116.             }
  1117.             *p = backslash(c);
  1118.         }
  1119.         *p = 0;
  1120.         yylval.sym = (Symbol *)emalloc(strlen(sbuf + 1));
  1121.         strcpy(yylval.sym, sbuf);
  1122.         return STRING;
  1123.     }
  1124.     switch (c) {
  1125.     case '>':    return follow('=', GE, GT);
  1126.     case '<':    return follow('=', LE, LT);
  1127.     case '=':    return follow('=', EQ, '=');
  1128.     case '!':    return follow('=', NE, NOT);
  1129.     case '|':    return follow('|', OR, '|');
  1130.     case '&':    return follow('&', AND, '&');
  1131.     case '\n':    lineno++; return '\n';
  1132.     default:    return c;
  1133.     }
  1134. }
  1135.  
  1136. backslash(c)    /* get next char with \'s interpreted */
  1137. int c;
  1138. {
  1139.     char *index();    /* `strchr()' in some systems */
  1140.     static char transtab[] = "b\bf\fn\nr\rt\t";
  1141.     if (c != '\\')
  1142.         return c;
  1143.     c = getc(fin);
  1144.     if (islower(c) && index(transtab, c))
  1145.         return index(transtab, c)[1];
  1146.     return c;
  1147. }
  1148.  
  1149. follow(expect, ifyes, ifno)    /* look ahead for >=, etc. */
  1150. {
  1151.     int c = getc(fin);
  1152.     
  1153.     if (c == expect)
  1154.         return ifyes;
  1155.     ungetc(c, fin);
  1156.     return ifno;
  1157. }
  1158.  
  1159. defnonly(s)    /* warn if illegal definition */
  1160. char *s;
  1161. {
  1162.     if (!indef)
  1163.         execerror(s, "used outside definition");
  1164. }
  1165.  
  1166. yyerror(s)    /* report compile-time error */
  1167. char *s;
  1168. {
  1169.     warning(s, (char *)0);
  1170. }
  1171.  
  1172. execerror(s, t)    /* recover from run-time error */
  1173. char *s, *t;
  1174. {
  1175.     warning(s, t);
  1176.     fseek(fin, 0L, 2);    /* flush rest of file */
  1177.     longjmp(begin, 0);
  1178. }
  1179.  
  1180. fpecatch()    /* catch floating point exceptions */
  1181. {
  1182.     execerror("floating point exception", (char *)0);
  1183. }
  1184.  
  1185. main(argc, argv)    /* hoc */
  1186. int argc;
  1187. char *argv[];
  1188. {
  1189.     int i, fpecatch();
  1190.     
  1191.     progname = argv[0];
  1192.     if (argc == 1) {    /* fake an argument list */
  1193.         static char *stdinonly[] = { "-" };
  1194.         
  1195.         gargv = stdinonly;
  1196.         gargc = 1;
  1197.     } else {
  1198.         gargv = argv + 1;
  1199.         gargc = argc - 1;
  1200.     }
  1201.     init();
  1202.     while (moreinput())
  1203.         run();
  1204.     return 0;
  1205. }
  1206.  
  1207. moreinput()
  1208. {
  1209.     if (gargc-- <= 0)
  1210.         return 0;
  1211.     if (fin && fin != stdin)
  1212.         fclose(fin);
  1213.     infile = *gargv++;
  1214.     lineno = 1;
  1215.     if (strcmp(infile, "-") == 0) {
  1216.         fin = stdin;
  1217.         infile = 0;
  1218.     } else if ((fin = fopen(infile, "r")) == NULL) {
  1219.         fprintf(stderr, "%s: can't open %s\n", progname, infile);
  1220.         return moreinput();
  1221.     }
  1222.     return 1;
  1223. }
  1224.  
  1225. run()    /* execute until EOF */
  1226. {
  1227.     setjmp(begin);
  1228.     signal(SIGFPE, fpecatch);
  1229.     for (initcode(); yyparse(); initcode())
  1230.         execute(progbase);
  1231. }
  1232.  
  1233. warning(s, t)    /* print warning message */
  1234. char *s, *t;
  1235. {
  1236.     fprintf(stderr, "%s: %s", progname, s);
  1237.     if (t)
  1238.         fprintf(stderr, " %s", t);
  1239.     if (infile)
  1240.         fprintf(stderr, " in %s", infile);
  1241.     fprintf(stderr, " near line %d\n", lineno);
  1242.     while (c != '\n' && c != EOF)
  1243.         c = getc(fin);    /* flush rest of input line */
  1244.     if (c == '\n')
  1245.         lineno++;
  1246. }
  1247.  
  1248.     
  1249. SHAR_EOF
  1250. cat << \SHAR_EOF > init.c
  1251. #include "hoc.h"
  1252. #include "y.tab.h"
  1253. #include <math.h>
  1254.  
  1255. extern double Log(), Log10(), Sqrt(), Exp(), Sinh(), Cosh(), Tanh(), Ran(), integer();
  1256.  
  1257. static struct {        /* Keywords */
  1258.     char    *name;
  1259.     int    kval;
  1260. } keywords[] = {
  1261.     "proc",        PROC,
  1262.     "func",        FUNC,
  1263.     "return",    RETURN,
  1264.     "if",        IF,
  1265.     "else",        ELSE,
  1266.     "while",    WHILE,
  1267.     "print",    PRINT,
  1268.     "read",        READ,
  1269.     0,        0
  1270. };
  1271.  
  1272. static struct {        /* Constants */
  1273.     char    *name;
  1274.     double    cval;
  1275. } consts[] = {
  1276.     "PI",        3.14159265358979323846,
  1277.     "E",        2.71828182845904523536,
  1278.     "GAMMA",    0.57721566490153286060,        /* Euler */
  1279.     "DEG",           57.29577951308232087680,        /* deg/radian */
  1280.     "PHI",        1.61803398874989484820,        /* golden ratio */
  1281.     0,        0
  1282. };
  1283.  
  1284. static struct {        /* Built-ins */
  1285.     char    *name;
  1286.     double    (*func)();
  1287. } builtins[] = {
  1288.     "sin",        sin,
  1289.     "cos",        cos,
  1290.     "tan",        tan,
  1291.     "asin",        asin,
  1292.     "acos",        acos,
  1293.     "atan",        atan,
  1294.     "sinh",        Sinh,        /* checks range */
  1295.     "cosh",        Cosh,        /* checks range */
  1296.     "tanh",        Tanh,        /* checks range */
  1297.     "log",        Log,        /* checks range */
  1298.     "log10",    Log10,        /* checks range */
  1299.     "exp",        Exp,        /* checks range */
  1300.     "sqrt",        Sqrt,        /* checks range */
  1301.     "int",        integer,
  1302.     "abs",        fabs,
  1303.     "ceil",        ceil,
  1304.     "floor",    floor,
  1305.     "ran",        Ran,
  1306.     0,        0
  1307. };
  1308.  
  1309. init()        /*install constants and built-ins in table */
  1310. {
  1311.     int i;
  1312.     Symbol *s;
  1313.     for (i = 0; keywords[i].name; i++)
  1314.         install(keywords[i].name, keywords[i].kval, 0.0);
  1315.     for (i = 0; consts[i].name; i++)
  1316.         install(consts[i].name, VAR, consts[i].cval);
  1317.     for (i = 0; builtins[i].name; i++) {
  1318.         s = install(builtins[i].name, BLTIN, 0.0);
  1319.         s->u.ptr = builtins[i].func;
  1320.     }
  1321. }
  1322.  
  1323. SHAR_EOF
  1324. cat << \SHAR_EOF > makefile
  1325. CFLAGS = +L +fi
  1326.  
  1327. OBJS = hoc.o code.o init.o math.o symbol.o
  1328.  
  1329. hoc:    $(OBJS)
  1330.     ln -o hoc $(OBJS) -lma32 -lc32
  1331.  
  1332. hoc.o y.tab.h: hoc.c
  1333.  
  1334. hoc.o code.o init.o symbol.o: hoc.h
  1335.  
  1336. code.o init.o symbol.o: y.tab.h
  1337.  
  1338. hoc.c: hoc.y
  1339.     yacc -d hoc.y
  1340.     @copy y.tab.c hoc.c
  1341. SHAR_EOF
  1342. cat << \SHAR_EOF > makefile.unix
  1343. YFLAGS = -d
  1344. OBJS = hoc.o code.o init.o math.o symbol.o
  1345.  
  1346. hoc:    $(OBJS)
  1347.     cc $(CFLAGS) $(OBJS) -lm -o hoc
  1348.  
  1349. hoc.o code.o init.o symbol.o: hoc.h
  1350.  
  1351. code.o init.o symbol.o: x.tab.h
  1352.  
  1353. x.tab.h:    y.tab.h
  1354.     -cmp -s x.tab.h y.tab.h || cp y.tab.h x.tab.h
  1355.  
  1356. pr:    hoc.y hoc.h code.c init.c math.c symbol.c
  1357.     @pr $?
  1358.     @touch pr
  1359.  
  1360. clean:
  1361.     rm -f $(OBJS) [xy].tab.[ch]
  1362. SHAR_EOF
  1363. cat << \SHAR_EOF > math.c
  1364. #include <math.h>
  1365. #include <errno.h>
  1366. extern int    errno;
  1367. double        errcheck();
  1368.  
  1369. double Log(x)
  1370. double x;
  1371. {
  1372.     return errcheck(log(x), "log");
  1373. }
  1374.  
  1375. double Log10(x)
  1376. double x;
  1377. {
  1378.     return errcheck(log10(x), "log10");
  1379. }
  1380.  
  1381. double Sqrt(x)
  1382. double x;
  1383. {
  1384.     return errcheck(sqrt(x), "sqrt");
  1385. }
  1386.  
  1387. double Exp(x)
  1388. double x;
  1389. {
  1390.     return errcheck(exp(x), "exp");
  1391. }
  1392.  
  1393. double Pow(x, y)
  1394. double x, y;
  1395. {
  1396.     return errcheck(pow(x, y), "exponentiation");
  1397. }
  1398.  
  1399. double Sinh(x)
  1400. double x;
  1401. {
  1402.     return errcheck(sinh(x), "sinh");
  1403. }
  1404.  
  1405. double Cosh(x)
  1406. double x;
  1407. {
  1408.     return errcheck(cosh(x), "cosh");
  1409. }
  1410.  
  1411. double Tanh(x)
  1412. double x;
  1413. {
  1414.     return errcheck(tanh(x), "tanh");
  1415. }
  1416.  
  1417. #define RAND_MAX 32767
  1418.  
  1419. double Ran(x)
  1420. double x;
  1421. {
  1422.     long time();
  1423.     srand( (int) time( (long *)0 ) );
  1424.     return (rand() / (RAND_MAX + 1.0) );
  1425. }
  1426.  
  1427. double integer(x)
  1428. double x;
  1429. {
  1430.     return (double)(long)x;
  1431. }
  1432.  
  1433. double errcheck(d, s)    /* check result of library call */
  1434. double d;
  1435. char *s;
  1436. {
  1437.     if (errno == EDOM) {
  1438.         errno = 0;
  1439.         execerror(s, "argument out of domain");
  1440.     } else if (errno == ERANGE) {
  1441.         errno = 0;
  1442.         execerror(s, "result out of range");
  1443.     }
  1444.     return d;
  1445. }
  1446. SHAR_EOF
  1447. cat << \SHAR_EOF > symbol.c
  1448. #include "hoc.h"
  1449. #include "y.tab.h"
  1450.  
  1451. static Symbol *symlist = 0;    /* symbol table: linked list */
  1452.  
  1453. Symbol *lookup(s)        /* find s in symbol table */
  1454. char *s;
  1455. {
  1456.     Symbol *sp;
  1457.  
  1458.     for (sp = symlist; sp != (Symbol *) 0; sp = sp->next)
  1459.         if (strcmp(sp->name, s) == 0)
  1460.             return sp;
  1461.     return 0;    /* 0 ==> not found */
  1462. }
  1463.  
  1464. Symbol *install(s, t, d)    /* install s in symbol table */
  1465. char *s;
  1466. int t;
  1467. double d;
  1468. {
  1469.     Symbol *sp;
  1470.     char *emalloc();
  1471.     
  1472.     sp = (Symbol *) emalloc(sizeof(Symbol));
  1473.     sp->name = emalloc(strlen(s) + 1);    /* +1 for '\0' */
  1474.     strcpy(sp->name, s);
  1475.     sp->type = t;
  1476.     sp->u.val = d;
  1477.     sp->next = symlist;    /* put at front of list */
  1478.     symlist = sp;
  1479.     return sp;
  1480. }
  1481.  
  1482. char *emalloc(n)    /* check return from malloc */
  1483. unsigned n;
  1484. {
  1485.     char *p, *malloc();
  1486.     
  1487.     p = malloc(n);
  1488.     if (p == 0)
  1489.         execerror("out of memory", (char *) 0);
  1490.     return p;
  1491. }
  1492. SHAR_EOF
  1493. cat << \SHAR_EOF > test.hoc
  1494. func stirl() {
  1495.     return sqrt(2*$1*PI) * ($1/E)^$1*(1 + 1/(12*$1))
  1496. }
  1497. func fac() {
  1498.     if ($1 <= 0) return 1 else return $1 * fac($1-1)
  1499. }
  1500. i = 0
  1501. print "     I     FAC(I)/STIRL(I)\n"
  1502. while ((i = i+1) <=20) {
  1503.     print i, "    ", fac(i)/stirl(i), "\n"
  1504. }
  1505. SHAR_EOF
  1506. #    End of shell archive
  1507. exit 0
  1508. -- 
  1509. Bob Page, U of Lowell CS Dept.  page@swan.ulowell.edu  ulowell!page
  1510. Have five nice days.
  1511.